home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Netware Super Library
/
Netware Super Library.iso
/
zipfiles
/
p2z
/
segue.exe
/
SS_FILER.PRG
< prev
next >
Wrap
Text File
|
1991-05-20
|
12KB
|
519 lines
*----------------------
* Function............FILEREAD()
* Action..............Lists a text file of unlimited size
* Returns.............nothing
* Category............Superfunction
* Syntax..............FILEREAD([expN1],[expN2],[expN3],[expN4],[expC])
* Description.........Lists text file [expC] of unlimited size in a user
* definable window. [expN1..expN4].
* Allows up down right left scrolling. Use this
* for reports or output sent to a disk file.
* Options.............If [expN1..expN4] are not passed, a default of
* window of dimensions 2,2,22,78 is used. If no
* filename [expC] is passed, a popup picklist is
* used to get a file name from the current
* directory.
* Examples............REPORT FORM summary TO summary.txt
* FILEREAD(2,2,22,78,"SUMMARY.TXT")
* Notes...............Unlimited file size. Won't bomb like memoedit.
* However, not nearly as fast as memoedit and
* no editing capabilities.
*
* Fileread uses a 98% Clipper code routine to
* list text files.
*
* Inspired by Mike Taylors DISPLAY() function
* written in C/ASM and in the Public Domain
*
* Warnings............Leaves cursor set ON
*----------------------
FUNCTION Fileread
PARAM boxtop,boxleft,boxbot,boxright,filename
PRIVATE handle,topline,botline,leftedge,rightedge,linelength
PRIVATE nbrlines,lineoffset,kounter,endof_file
PRIVATE last_key,standard,position
*initsup()
*- were all params passed
*- if filename not passed, get one
IF Pcount() < 5
filename = SPACE(12)
one_read("File to list (ENTER or *Wildcards for picklist - ESC to exit)","filename","")
IF LASTKEY() = 27
RETURN .F.
ENDIF
IF EMPTY(m->filename) .OR. AT('*',m->filename) > 0
IF EMPTY(m->filename)
filename = "*.*"
ENDIF
filename = popex(m->filename)
ENDIF
IF LASTKEY() = 27
RETURN .F.
ENDIF
ENDIF
*- assign box dimensions if need be
IF Pcount() < 4
boxtop = 2
boxleft= 2
boxbot = 22
boxright = 78
ENDIF
*- check for file's existence
IF !FILE(m->filename)
RETURN .F.
ENDIF
*- open the file, check for errors
handle = FOPEN(m->filename,0)
IF Ferror() <> 0
msg("Error opening file : "+m->filename)
RETURN ''
ENDIF
*- not at the end of file
endof_file = .F.
*- set cursor off
SET CURSOR OFF
*- draw screen
PRIVATE r_file
r_file=makebox(m->boxtop,m->boxleft,m->boxbot,m->boxright,m->c_popcol,0,0)
@m->boxbot-2,m->boxleft TO m->boxbot-2,m->boxright
@m->boxbot-2,m->boxleft SAY CHR(195)
@m->boxbot-2,m->boxright SAY CHR(180)
@m->boxtop,m->boxleft+2 SAY '['+UPPER(m->filename)+']'
@m->boxbot-1,m->boxleft+2 SAY'['+CHR(24)+CHR(25)+CHR(26)+CHR(27)+' PGUP PGDN HOME END] [ESC to quit]'
*-
*- initialize dimensions for screen output of file
topline = m->boxtop+1
botline = m->boxbot-3
leftedge = m->boxleft+1
rightedge = m->boxright-1
*- get line length, number of lines in box, and starting line offset
linelength = m->boxright-m->boxleft-1
nbrlines = m->boxbot-m->boxtop-3
lineoffset = 1
*- store standard color to a variable
standard = standard()
*- initialize two arrays - one for the current set of lines, and one for
*- the file offset of each line
PRIVATE Lines[m->nbrlines],Offset[m->nbrlines]
*- draw the first set of lines , storing the values in the above two
*- arrays
rf_sayall()
DO WHILE .T.
*- wait for a key
INKEY(0)
last_key = LASTKEY()
DO CASE
CASE m->last_key = 5 .AND. Offset[1] > 0
*- go to offset of first line
position = Offset[1]
FSEEK(m->handle,m->position)
*- move up one line
rf_scrlup()
*- we're not at the end of file
endof_file = .F.
CASE m->last_key = 24 .AND. !m->endof_file
*- move down one line
rf_scrldn(1)
CASE m->last_key = 18
*- go to offset of first line
FSEEK(m->handle,Offset[1])
*- move up one full page of lines
kounter = 1
FOR m->kounter = 1 TO m->nbrlines
fgobak()
NEXT
*- now paint the current set of lines, filling in the arrays
rf_sayall()
*- not at end of file
endof_file = .F.
CASE m->last_key = 3 .AND. !m->endof_file
*- move down one full page of lines
rf_scrldn(m->nbrlines)
CASE m->last_key = 1
*- not at end of file
endof_file = .F.
*- go to beginning if file
ftop(m->handle)
*- now paint the current set of lines, filling in the arrays
rf_sayall()
CASE m->last_key = 6 .AND. !m->endof_file
*- go to the end of the file
fbot(m->handle)
*- move back one full screen of lines
kounter = 1
FOR m->kounter = 1 TO m->nbrlines
fgobak()
NEXT
*- now paint the current set of lines, filling in the arrays
rf_sayall()
*- we are at the end of file
endof_file = .T.
CASE m->last_key = 27
*- close the file and exit the loop
Fclose(m->handle)
EXIT
CASE m->last_key = 4
*- if the longest element of the current lines[] array is longer
*- than the linelength of the box, move the line offset over 5
*- places
IF bigelem(m->lines) >= (m->lineoffset+m->linelength)
lineoffset = m->lineoffset+5
rf_resay()
ENDIF
CASE m->last_key = 19
IF m->lineoffset > 1
lineoffset = MAX(m->lineoffset-5,1)
*- just redraw the lines starting at the new line offset
rf_resay()
ENDIF
ENDCASE
ENDDO
*- set cursor on
SET CURSOR ON
unbox(m->r_file)
RETURN ''
FUNCTION rf_sayall
PRIVATE kounter
*- fill the arrays with .f.
Afill(m->lines,.F.)
Afill(m->offset,.F.)
*- clear the window
Scroll(m->topline,m->leftedge,m->botline,m->rightedge,0)
*- for # of lines allowed in box
kounter = 1
FOR m->kounter = 1 TO m->nbrlines
*- get current offset into array element
Offset[m->kounter] = FSEEK(m->handle,0,1)
*- get current line contents into array element
Lines[m->kounter] = fgetline(m->handle)+SPACE(10)
*- display the line within the box
prnt(m->boxtop+m->kounter,m->leftedge,SUBST(Lines[m->kounter],m->lineoffset,m->linelength),m->standard)
NEXT
RETURN ''
FUNCTION rf_resay
PRIVATE kounter
*- clear the box
Scroll(topline,leftedge,botline,rightedge,0)
*- for # of lines in box
FOR m->kounter = 1 TO m->nbrlines
*- redisplay the line
prnt(m->boxtop+m->kounter,m->leftedge,SUBST(Lines[m->kounter],m->lineoffset,m->linelength),m->standard)
NEXT
RETURN ''
FUNCTION rf_scrlup
PRIVATE seekto,position
*- not at end of file
endof_file = .F.
*- but if at beginning of file, no going up
IF Offset[1]=0
RETURN ''
ENDIF
*- go up one line
fgobak()
*- if we didn't move, return
IF FSEEK(m->handle,0,1) = Offset[1]
RETURN ''
ENDIF
*- insert a new element into position one of the arrays
AINS(Lines,1)
AINS(Offset,1)
*- put new offset and line into new array element
Offset[1]= FSEEK(m->handle,0,1)
position = Offset[1]
Lines[1]=fgetline(m->handle)+SPACE(10)
*- go to beginning of line
FSEEK(m->handle,m->position)
*- scroll the screen down one
Scroll(m->topline,m->leftedge,m->botline,m->rightedge,-1)
*- draw the new line at top of the box
prnt(m->topline,m->leftedge,SUBST(Lines[1],m->lineoffset,m->linelength),m->standard)
RETURN ''
FUNCTION rf_scrldn
PARAM how_many
PRIVATE kounter
*- first go to last line offset
FSEEK(m->handle,Offset[m->nbrlines])
*- move up one line
fgetline(m->handle)
*- for # of lines specified
FOR m->kounter = 1 TO m->how_many
*- if its the end of the file, don't continue
*- ( fgetline() will set this variable if EOF )
IF endof_file
EXIT
ENDIF
*- delete element 1 in each array, thus shifting the other
*- elements down one
Adel(m->lines,1)
Adel(m->offset,1)
*- get offset of next line
Offset[m->nbrlines]=FSEEK(m->handle,0,1)
*- get next line
Lines[m->nbrlines]=fgetline(m->handle)+SPACE(10)
*- scroll the screen up one line
Scroll(m->topline,m->leftedge,m->botline,m->rightedge,1)
*- print the line
prnt(m->botline,m->leftedge,SUBST(Lines[m->nbrlines],m->lineoffset,m->linelength),m->standard)
NEXT
RETURN ''
FUNCTION fgetline
PRIVATE return_line,chunk,bigchunk,oldoffset,at_chr13
return_line = ''
bigchunk = ''
oldoffset = FSEEK(m->handle,0,1)
DO WHILE .T.
*- read in a chunk of the file
chunk = ''
chunk = Freadstr(m->handle,100)
*- if we didn't read anything in, guess we're at the EOF
IF LEN(m->chunk)=0
endof_file = .T.
*-Wed 11-29-1989
IF !EMPTY(m->bigchunk)
return_line = m->bigchunk
ENDIF
*-Wed 11-29-1989
EXIT
ENDIF
*- add this chunk to the big chunk
bigchunk = m->bigchunk+m->chunk
*- if we've got a CR , we've read in a line
*- otherwise we'll loop again and read in another chunk
IF AT(CHR(13),m->bigchunk) > 0
at_chr13 =AT(CHR(13),m->bigchunk)
*- go back to beginning of line
FSEEK(m->handle,m->oldoffset)
*- read in from here to next CR (-1)
return_line = Freadstr(m->handle,m->at_chr13-1)
*- move the pointer 1 byte
FSEEK(m->handle,1,1)
EXIT
ENDIF
ENDDO
*- move the pointer 1 byte
*- this should put us at the beginning of the next line
FSEEK(m->handle,1,1)
*- return the contents of the line
RETURN m->return_line
FUNCTION fgobak
PRIVATE move_to,chunk,Buffer
*- assume current position is beginning of a line
*- save old offset
oldoffset = FSEEK(m->handle,0,1)
oldoffset = FSEEK(m->handle,MAX(0,m->oldoffset-3))
*- if we're at the beginning of file, return
IF m->oldoffset = 0
RETURN ''
ENDIF
*- determine where we're going to move to, but not beyond beginning if file
move_to = MAX(m->oldoffset-160,0)
*- move backwards that many bytes
move_to = FSEEK(m->handle,m->move_to)
*- now read in a line from here to the old offset
chunk = Freadstr(m->handle,m->oldoffset-m->move_to)
*- see if there's a CHR(10) in the lot
IF AT(CHR(10),m->chunk) = 0
*- if no chr(10)
DO WHILE .T.
*- move back 1 - but not past beginning of file
move_to = MAX(m->move_to-1,0)
*- if the offset to go to is less than 1, we're apparantly at the
*- beginning of the file, so just move the pointer to the beggining
*- of the file and exit
IF m->move_to < 1
FSEEK(m->handle,0)
EXIT
ENDIF
*- move the pointer to the new position
FSEEK(m->handle,m->move_to)
*- set up a buffer 1 byte long
Buffer = ' '
*- read in a byte
Fread(m->handle,@Buffer,1)
IF m->buffer==CHR(10)
*- if its a chr(10), exit - otherwise loop back around
EXIT
ENDIF
ENDDO
ELSE
*- ok, so we've got one - or more
*- determine where it is
move_to = m->move_to+Rat(CHR(10),m->chunk)
*- and move to that position
FSEEK(m->handle,m->move_to)
ENDIF
FUNCTION fbot
FSEEK(m->handle,0,2)
RETURN ''
FUNCTION ftop
FSEEK(m->handle,0)
RETURN ''
* History 11-29-1989 Added code to catch last line in
* text file
* 01-17-1990 to popup using currently selected color
* 04-08-1990 removed calls to functions using
* Clipper internals (S_STAT, PUSH_KEYS, POP_KEYS)
*: EOF: S_FILER.PRG